home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / Libraries / PNL Libraries / MyStrh.p < prev    next >
Encoding:
Text File  |  1995-10-22  |  6.6 KB  |  276 lines  |  [TEXT/CWIE]
  1. unit MyStrH;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Types;
  7.  
  8.     type
  9.         lineIndex = integer;
  10.  
  11.     const
  12.         first_strh_offset = SizeOf(lineIndex);
  13.  
  14.     type
  15.         indexPtr = ^lineIndex;
  16.         StrHHandle = ^indexPtr;
  17.  
  18.     function NewStrH: StrHHandle;
  19.     function GetStrH (id: integer): StrHHandle; { NoPurged, but not detached! }
  20.     function Get1StrH (id: integer): StrHHandle; { NoPurged, but not detached! }
  21.     procedure DisposeStrH (hhhh: StrHHandle);
  22.     procedure ReleaseStrH (hhhh: StrHHandle);
  23.     procedure ReinitStrH (hhhh: StrHHandle);
  24.     function CountStrs (id: integer): lineIndex;
  25.     function CountStrsH (hhhh: StrHHandle): lineIndex;
  26.     function GetIndStr (id: integer; index: lineIndex): Str255;
  27.     function GetIndStrH (hhhh: StrHHandle; index: lineIndex): Str255;
  28.     function GetNextStrH (hhhh: StrHHandle; var offset: longint): Str255;
  29.     procedure SetIndStr (id, index: lineIndex; s: Str255);
  30.     procedure SetIndStrH (hhhh: StrHHandle; index: lineIndex; s: Str255);
  31.     procedure AppendStrH (hhhh: StrHHandle; s: Str255);
  32.     procedure DelIndStr (id: integer; index: lineIndex);
  33.     procedure DelIndStrH (hhhh: StrHHandle; index: lineIndex);
  34.     procedure InsIndString (id: integer; index: lineIndex; s: Str255);
  35.     procedure InsIndStrH (hhhh: StrHHandle; index: integer; s: Str255);
  36.     function ValidStringH (hhhh: StrHHandle): boolean;
  37.     procedure ResetStrH (hhhh: StrHHandle);
  38.  
  39. implementation
  40.  
  41.     uses
  42.         Memory, Resources, ToolUtils, TextUtils;
  43.  
  44.     function NewStrH: StrHHandle;
  45.     begin
  46.         NewStrH := StrHHandle(NewHandleClear(SizeOf(lineIndex)));
  47.     end;
  48.  
  49.     function GetStrH (id: integer): StrHHandle;
  50.         var
  51.             hhhh: Handle;
  52.     begin
  53.         hhhh := GetResource('STR#', id);
  54.         if hhhh <> nil then begin
  55.             HNoPurge(hhhh);
  56.         end;
  57.         GetStrH := StrHHandle(hhhh);
  58.     end;
  59.  
  60.     function Get1StrH (id: integer): StrHHandle;
  61.         var
  62.             hhhh: Handle;
  63.     begin
  64.         hhhh := Get1Resource('STR#', id);
  65.         if hhhh <> nil then begin
  66.             HNoPurge(hhhh);
  67.         end;
  68.         Get1StrH := StrHHandle(hhhh);
  69.     end;
  70.  
  71.     procedure DisposeStrH (hhhh: StrHHandle);
  72.     begin
  73.         DisposeHandle(Handle(hhhh));
  74.     end;
  75.  
  76.     procedure ReleaseStrH (hhhh: StrHHandle);
  77.     begin
  78.         ReleaseResource(Handle(hhhh));
  79.     end;
  80.  
  81.     procedure ReinitStrH (hhhh: StrHHandle);
  82.     begin
  83.         SetHandleSize(Handle(hhhh), SizeOf(lineIndex));
  84.         hhhh^^ := 0;
  85.     end;
  86.  
  87.     function CountStrsH (hhhh: StrHHandle): integer;
  88.     begin
  89.         CountStrsH := hhhh^^;
  90.     end;
  91.  
  92.     function CountStrs (id: integer): lineIndex;
  93.         var
  94.             hhhh: StrHHandle;
  95.     begin
  96.         hhhh := StrHHandle(GetResource('STR#', id));
  97.         CountStrs := hhhh^^;
  98.     end;
  99.  
  100.     function GetIndStr (id: integer; index: lineIndex): Str255;
  101.         var
  102.             s: Str255;
  103.     begin
  104.         GetIndString(s, id, index);
  105.         GetIndStr := s;
  106.     end;
  107.  
  108.     function ValidStringH (hhhh: StrHHandle): boolean;
  109.         var
  110.             count, i: lineIndex;
  111.             ps: longint;
  112.     begin
  113.         ValidStringH := false;
  114.         if GetHandleSize(Handle(hhhh)) >= SizeOf(lineIndex) then begin
  115.             count := hhhh^^;
  116.             ps := SizeOf(lineIndex);
  117.             for i := 1 to count do begin
  118.                 ps := ps + BAND(ptr(ord(hhhh^) + ps)^, $FF) + 1;
  119.             end;
  120.             ValidStringH := GetHandleSize(Handle(hhhh)) = ps;
  121.         end;
  122.     end;
  123.  
  124.     function GetIndStrH (hhhh: StrHHandle; index: lineIndex): Str255;
  125.         var
  126.             count, i: lineIndex;
  127.             s: Str255;
  128.             ps: longint;
  129.     begin
  130.         count := hhhh^^;
  131.         if (1 <= index) and (index <= count) then begin
  132.             ps := SizeOf(lineIndex);
  133.             for i := 1 to index - 1 do begin
  134.                 ps := ps + BAND(ptr(ord(hhhh^) + ps)^, $FF) + 1;
  135.             end;
  136.             BlockMoveData(ptr(ord(hhhh^) + ps), @s, BAND(ptr(ord(hhhh^) + ps)^, $FF) + 1);
  137.         end
  138.         else begin
  139.             s := '';
  140.         end;
  141.         GetIndStrH := s;
  142.     end;
  143.  
  144.     function GetNextStrH (hhhh: StrHHandle; var offset: longint): Str255;
  145.         var
  146.             s: Str255;
  147.             len: integer;
  148.     begin
  149.         if offset >= GetHandleSize(Handle(hhhh)) then begin
  150.             s := '';
  151.         end
  152.         else begin
  153.             len := BAND(ptr(ord(hhhh^) + offset)^, $FF);
  154.             BlockMoveData(ptr(ord(hhhh^) + offset), @s, len + 1);
  155.             offset := offset + len+1;
  156.         end;
  157.         GetNextStrH := s;
  158.     end;
  159.  
  160.     procedure ResetStrH (hhhh: StrHHandle);
  161.     begin
  162.         SetHandleSize(Handle(hhhh), SizeOf(lineIndex));
  163.         hhhh^^ := 0;
  164.     end;
  165.  
  166.     procedure SetIndStrH (hhhh: StrHHandle; index: lineIndex; s: Str255);
  167.         var
  168.             count, i: lineIndex;
  169.             sz: longint;
  170.             p: longint;
  171.             pos: longint;
  172.             ps: longint;
  173.     begin
  174.         count := hhhh^^;
  175.         sz := GetHandleSize(Handle(hhhh));
  176.         if count < index then begin
  177.             SetHandleSize(Handle(hhhh), sz + index - count);
  178.             if MemError <> noErr then begin
  179.                 Exit(SetIndStrH);
  180.             end;
  181.             for p := ord(hhhh^) + sz to ord(hhhh^) + sz + index - count - 1 do begin
  182.                 ptr(p)^ := 0;
  183.             end;
  184.             hhhh^^ := index;
  185.             count := index;
  186.         end;
  187.         ps := SizeOf(lineIndex);
  188.         for i := 1 to index - 1 do begin
  189.             ps := ps + BAND(ptr(ord(hhhh^) + ps)^, $FF) + 1;
  190.         end;
  191.         pos := Munger(Handle(hhhh), ps, nil, BAND(ptr(ord(hhhh^) + ps)^, $FF) + 1, @s, length(s) + 1);
  192.     end;
  193.  
  194.     procedure AppendStrH (hhhh: StrHHandle; s: Str255);
  195.     begin
  196.         if PtrAndHand(@s, Handle(hhhh), length(s) + 1) = noErr then begin
  197.             hhhh^^ := hhhh^^ + 1;
  198.         end;
  199.     end;
  200.  
  201.     procedure SetIndStr (id, index: lineIndex; s: Str255);
  202.         var
  203.             hhhh: StrHHandle;
  204.     begin
  205.         hhhh := StrHHandle(GetResource('STR#', id));
  206.         HNoPurge(Handle(hhhh));
  207.         SetIndStrH(hhhh, index, s);
  208.         HPurge(Handle(hhhh));
  209.         ChangedResource(Handle(hhhh));
  210.         WriteResource(Handle(hhhh));
  211.     end;
  212.  
  213.     procedure DelIndStrH (hhhh: StrHHandle; index: integer);
  214.         var
  215.             count, i: lineIndex;
  216.             sz: longint;
  217.             pos: longint;
  218.             ps: longint;
  219.     begin
  220.         count := hhhh^^;
  221.         sz := GetHandleSize(Handle(hhhh));
  222.         if count >= index then begin
  223.             ps := SizeOf(lineIndex);
  224.             for i := 1 to index - 1 do begin
  225.                 ps := ps + BAND(ptr(ord(hhhh^) + ps)^, $FF) + 1;
  226.             end;
  227.             pos := Munger(Handle(hhhh), ps, nil, BAND(ptr(ord(hhhh^) + ps)^, $FF) + 1, @pos, 0); { @err is a safe, non nil addr }
  228.             hhhh^^ := count - 1;
  229.         end;
  230.     end;
  231.  
  232.     procedure DelIndStr (id: integer; index: lineIndex);
  233.         var
  234.             hhhh: StrHHandle;
  235.     begin
  236.         hhhh := StrHHandle(GetResource('STR#', id));
  237.         HNoPurge(Handle(hhhh));
  238.         DelIndStrH(hhhh, index);
  239.         HPurge(Handle(hhhh));
  240.         ChangedResource(Handle(hhhh));
  241.         WriteResource(Handle(hhhh));
  242.     end;
  243.  
  244.     procedure InsIndStrH (hhhh: StrHHandle; index: integer; s: Str255);
  245.         var
  246.             count, i: lineIndex;
  247.             pos: longint;
  248.             ps: longint;
  249.             t: string[2];
  250.     begin
  251.         count := hhhh^^;
  252.         if count >= index then begin
  253.             ps := SizeOf(lineIndex);
  254.             for i := 1 to index - 1 do begin
  255.                 ps := ps + BAND(ptr(ord(hhhh^) + ps)^, $FF) + 1;
  256.             end;
  257.             t := '';
  258.             pos := Munger(Handle(hhhh), ps, nil, 0, @t, length(t) + 1);
  259.             hhhh^^ := count + 1;
  260.         end;
  261.         SetIndStrH(hhhh, index, s)
  262.     end;
  263.  
  264.     procedure InsIndString (id: integer; index: lineIndex; s: Str255);
  265.         var
  266.             hhhh: StrHHandle;
  267.     begin
  268.         hhhh := StrHHandle(GetResource('STR#', id));
  269.         HNoPurge(Handle(hhhh));
  270.         InsIndStrH(hhhh, index, s);
  271.         HPurge(Handle(hhhh));
  272.         ChangedResource(Handle(hhhh));
  273.         WriteResource(Handle(hhhh));
  274.     end;
  275.  
  276. end.